BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Tele/Pete Johnson/HelloTabby.p Folder/HelloTabby.p

Text File | 1991-06-23 | 12.6 KB | 369 lines | [TEXT/PJMM]

unit HelloTabby;

{     Written by Pete Johnson                                            }
{    Version 1.0 of June 22, 1991 -- first version number assigned            }

{ Source for a Think Pascal unit which handles the Tabby launch.next file,        }
{ returns the name of the next application to launch in a variable called        }
{ NextLaunch and allows MultiFinder some cycles if the Tabby Setup file says    }
{ Multifinder is running.                                            }

{            ********** History **********                                }

{ Modified Mar. 11, 1989, to handle up to 100 events of < 32 chars apiece.        }
{ Modified Apr. 17 and May 6, 1989, to handle MultiFinder.                    }
{ Modified June 11, 1989, to use Toolbox file calls.                        }
{ Modified June 15, 1989, to use Tabby Setup name for 'BBS' string.            }
{ Modified July 22, 1989, for additional error checking.                    }
{ Modified Nov. 19, 1989, to incorporate WaitNextEvent delay for MultiFinder    }
{ Modified Jan. 20, 1990, to include all variable declarations necessary --    }
{                        this unit uses no external globals.            }
{ Modified Mar. 03, 1990, to use Tabby Setup file rather than Config file for    }
{                        info re: MF, BBSName etc. This allows Mansion    }
{                        compatibility.                                }
{ Modified June 16, 1991, to record default path and some other subtle changes.    }
{ Modified June 22, 1991, to make backup of launch.next file in case of error.    }

{ This source code is being made public in the hopes that it will lead to more    }
{ and better Tabby applications. I ask only that you credit me with a thanks    }
{ if you incorporate any or all of this code in an application. If you improve    }
{ on this code, please share your ideas.                                }

{ If you're not using Think Pascal, you're on your own. I'm sure someone        }
{ other than me can help you if you need to convert this code for Turbo, TML    }
{ or Apple's MPW Pascal.                                                }

{ Thanks to Erik Selberg, who has been a real help.                        }

{ How to use this code:                                                }

{  <1> Create a Think Pascal Project                                    }
{  <2> Add the HelloTabby.p file as the first unit                        }
{  <3> Create your own additional files                                    }

{ You should include an STR  resource 500 in the Project: this holds the name    }
{ of the default launch.next application (usually the BBS application).        }

{   Your main program Unit should include the following lines at its start:    }

{     uses                                                        }
{       HelloTabby;                                                    }

{   Begin the main procedure of your program as follows:                    }

{    HelloTabby;                                                    }

{   End the main procedure of your program as follows:                        }

{    if NextLaunch <> '' then                                            }
{       LaunchNextAppl                                                }
{    end.                                                            }

{    The following global variables are available to your program:            }

{    NextLaunch: STR255;        --    Name of next app to launch, empty if none.    }
{    MultiFinder : boolean;    --    True if Tabby Config says MF, else false.    }
{    Err: OSErr;            --    General variable you can use for OSErrs.    }
{    vRefNum: integer;        --    Reference number of default volume.        }
{    dirID: longint;        --    Reference number of default directory.        }
{    gDefaultpath: str255    --    Full path to default dir (ends w/colon).    }
{    gVolName: STR255;        --    Name of default volume.                    }
{    BBSName: STR255;        --    Name of BBS application                    }
{    BaudString: STR255;        --    Baud rate from Tabby Setup in ASCII        }
{    PortString: STR255;        --    'a' = modem, 'b' = printer                }

interface

    type
        pLaunchStruct = ^LaunchStruct;
        LaunchStruct = record
                pfName: StringPtr;
                param: INTEGER;
                LC: packed array[0..1] of CHAR;    {    extended parameters:                    }
                extBlockLen: LONGINT;             {    number of bytes in extension = 6            }
                fFlags: INTEGER;                    {    Finder file info flags                    }
                launchFlags: LONGINT;             {    bit 31,30=1 for sublaunch, others reserved    }
            end;                             {    LaunchStruct                            }

    const
        sleep = 10;

    var
        NextLaunch, gVolName, BBSName, BaudString, PortString, gDefaultpath: STR255;
        MultiFinder: boolean;
        Err: OSErr;
        vRefNum: integer;
        dirID: longint;
        IgnoreBool: boolean;                {    These variables for WaitNextEvent calls    }
        TabbyEventRec: EventRecord;

    function PathNameFromDirID (DirID: longint; vRefNum: integer): str255;

    procedure LaunchNextAppl;

    procedure HelloTabby;

    procedure ReadTabbyConfig;

    function ReadALine (FileRefNum: integer; var TheMessage: string): OSErr;    {very useful!}

implementation

{-----------------------------------------------------------------    }

    function ReadALine;        {    (FileRefNum: integer; var TheMessage: string): OSErr;    }

        var
            myPB: ParamBlockRec;
            myString: Str255;

    begin
        myString := '';
        myPB.ioCompletion := nil;
        myPB.ioRefNum := FileRefNum;
        myPB.ioBuffer := Pointer(@myString[1]);
        myPB.ioReqCount := 255;
        myPB.ioPosMode := 3456; {ASCII 13*256+128}
        myPB.ioPosOffset := 0; {ignored}
        ReadALine := PBRead(@myPB, False);
        if (myString[myPB.ioActCount] = chr(13)) then
            myString[0] := char(myPB.ioActCount - 1) {Drop CR}
        else
            myString[0] := char(myPB.ioActCount);
        TheMessage := myString
    end;

{-----------------------------------------------------------------    }

    procedure ReadTabbyConfig;

        var
            ConfigRefNum, MFCount: integer;
            OneLine: str255;

    begin
        Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Setup'), vRefNum, ConfigRefNum);
        if Err = noErr then
            begin
                Err := ReadALine(ConfigRefNum, BBSName);    {    Name of BBS application        }
                Err := ReadALine(ConfigRefNum, OneLine);    {    MF status: 1 true, 0 false    }
                if OneLine[1] = '1' then
                    begin
                        MultiFinder := true;
    {    We now have a valid boolean value for MultiFinder, so let's yield time if appropriate.    }
    {    10 ticks (1/6 sec) times 20 = 3.2 seconds -- same value Michael Connick uses.            }
                        for MFCount := 1 to 20 do
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
                    end
                else
                    MultiFinder := false;
                Err := ReadALine(ConfigRefNum, BaudString);    {    Baud rate in ASCII            }
                Err := ReadALine(ConfigRefNum, PortString)    {    'a' = modem, 'b' = printer    }
            end;        {    if Err = noErr    }
        Err := FSClose(ConfigRefNum)
    end;

{ ------------------------------------------------------ }

    function Launchit (pLnch: pLaunchStruct): OSErr;

    inline
        $205F, $A9F2, $3E80;

{ ------------------------------------------------------ }

    procedure LaunchNextAppl;

        var
            pMyLaunch: pLaunchStruct;
            myLaunch: LaunchStruct;
            MyPB: CInfoPBRec;
            MFCount: integer;

    begin

        with MyPB do
            begin
                ioNamePtr := @NextLaunch;
                ioVRefNum := vRefNum;
                ioFDirIndex := 0;
                ioDirID := 0;
            end;    {    with    }
        Err := PBGetCatInfo(@MyPB, false);

        pMyLaunch := @myLaunch;
        with pMyLaunch^ do
            begin
                pfName := @NextLaunch;
                param := 0;
                LC[0] := 'L';
                LC[1] := 'C';
                extBlockLen := 6;
                fFlags := myPB.ioFlFndrInfo.fdFlags;
                if MultiFinder then
                    LaunchFlags := $C0000000            {    set BOTH high bits for a sublaunch        }
                else
                    LaunchFlags := $00000000;        {    just launch, then quit                }
            end;                            {    with pMyLaunch^                    }
        if MultiFinder then
            for MFCount := 1 to 20 do
                IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);    {    Give away more cycles    }
        Err := Launchit(pMyLaunch)
    end;

{ ------------------------------------------------------ }

    function PathNameFromDirID;{ (DirID: longint; vRefNum: integer): str255}

        var
            Block: CInfoPBRec;
            directoryName, FullPathName: str255;

    begin
        FullPathName := '';
        with Block do
            begin
                ioNamePtr := @directoryName;
                ioDrParID := DirID
            end;

        repeat
            with Block do
                begin
                    ioVRefNum := vRefNum;
                    ioFDirIndex := -1;
                    ioDrDirID := Block.ioDrParID
                end;
            err := PBGetCatInfo(@Block, FALSE);

            directoryName := concat(directoryName, ':');
            FullPathName := concat(directoryName, FullPathName)
        until (Block.ioDrDirID = fsRtDirID);

        PathNameFromDirID := FullPathName
    end;

{ ------------------------------------------------------ }

    procedure HelloTabby;

{ This procedure looks for a Tabby launch.next file. If it's found, it         }
{ extracts the events, which are comma delimited, saves the first one            }
{ for the next launch and rewrites the file from event #2 to the last            }
{ event.                                                            }

{ If it finds only one event, it kills the launch.next file.                   }

{ If there are no events, it returns the application name contained in        }
{ STR  500 as STR255 NextLaunch, otherwise it uses NextLaunch to hold          }
{ the first entry in the launch.next script.                                 }

{ Before returning, it also checks that the NextLaunch application exists        }
{ by trying to    open it. If the open attempt fails, it returns NextLaunch        }
{ as an empty string.                                                }

        type
            HundredEvents = array[1..100] of string[32];
            ManyChars = packed array[1..3300] of char;    {    Can hold 100 32-length events, commas and one <CR>    }

        var
            EventCounter, EventLimit, LNRefNum, LaunchCount: integer;
            LNChar: char;
            TheChars: ManyChars;
            Event: HundredEvents;
            Events, ThisEvent, TempString, BBSName: STR255;
            logicalEOF, Quantity, CharIndex: longint;
            CharCount, SetUpRef, SetUpCount: integer;
            fndrInfo: FInfo;

    begin
        SetCursor(GetCursor(WatchCursor)^^);
        Err := HGetVol(@gVolName, vRefNum, dirID);        { Get volume ref # & dirID for default volume    }
        gDefaultpath := PathNameFromDirID(dirID, vRefNum);    { Get full pathname                            }
        Events := '';
        for EventCounter := 1 to 100 do
            Event[EventCounter] := '';
        ThisEvent := '';
        LNChar := chr(255);                    {    Dummy value so we can spot this first time through    }
        NextLaunch := GetString(500)^^;        {    Get next launch string from resource                }
        ReadTabbyConfig;                    {    See if we're running MultiFinder & yield time if so    }
        EventCounter := 1;
        Err := FSOpen(concat(gDefaultpath, 'launch.next'), vRefNum, LNRefNum);
        Err := GetEOF(LNRefNum, logicalEOF);
        if (logicalEOF > 0) and (Err = NoErr) then
            begin
                Err := SetFPos(LNRefNum, fsFromStart, 0);
                LaunchCount := 0;
                while (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        while (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
                            begin
                                if (LNChar <> chr(255)) then
                                    ThisEvent := concat(ThisEvent, LNChar);
                                LaunchCount := LaunchCount + 1;
                                Quantity := 1;
                                Err := FSRead(LNRefNum, Quantity, @LNChar);
                                LNChar := chr(ord(LNChar) div 256);
                            end;            { (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
                        Event[EventCounter] := ThisEvent;
                        EventCounter := EventCounter + 1;
                        ThisEvent := '';
                        LNChar := chr(255)
                    end;            { (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
                Err := FSClose(LNRefNum);
                Err := FSDelete(concat(gDefaultpath, 'launch.next'), vRefNum);
                EventLimit := (EventCounter - 2);
                if EventLimit > 1 then
                    begin
                        Err := Create(concat(gDefaultpath, 'launch.next'), vRefNum, 'QED1', 'TEXT');
                        Err := FSOpen(concat(gDefaultpath, 'launch.next'), vRefNum, LNRefNum);
                        Err := SetFPos(LNRefNum, fsFromStart, 0);
                        CharIndex := 0;
                        for EventCounter := 2 to EventLimit do
                            begin
                                if MultiFinder then
                                    IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                                TempString := Event[EventCounter];
                                for CharCount := 1 to length(TempString) do
                                    TheChars[CharIndex + CharCount] := TempString[CharCount];
                                CharIndex := CharIndex + length(TempString) + 1;
                                if EventCounter <> EventLimit then
                                    TheChars[CharIndex] := ','
                                else
                                    TheChars[CharIndex] := chr(13);
                            end; {Counter loop}
                        Err := FSWrite(LNRefNum, CharIndex, @TheChars);
                        Err := FSClose(LNRefNum);
                        Err := FlushVol(@gVolName, vRefNum);
                    end; {EventLimit > 1}
                if EventLimit > 0 then
                    NextLaunch := Event[1];
                TempString := NextLaunch;
                UprString(TempString, false);
                if TempString = 'BBS' then
                    begin
                        Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Setup'), vRefNum, SetupRef);
                        if Err = NoErr then
                            Err := GetEOF(SetupRef, logicalEOF);
                        if (logicalEOF > 0) & (Err = NoErr) then
                            begin
                                Err := ReadALine(LNRefNum, NextLaunch);
                                Err := FSClose(SetupRef);
                            end        {    if logicalEOF > 0 for 'Tabby Setup'    }
                    end;        {    if TempString = 'BBS'     }
            end        {    if logicalEOF > 0 for 'launch.next'    }
        else
            begin
                Err := FSClose(LNRefNum);
                Err := FSDelete(concat(gDefaultpath, 'launch.next.bak'), vRefNum);
                Err := Rename(concat(gDefaultpath, 'launch.next'), vRefNum, concat(gDefaultpath, 'launch.next.bak'))
            end;
        Err := GetFInfo(NextLaunch, vRefNum, fndrInfo);    {    Is it an application?    }
        if (Err <> noErr) | (fndrInfo.fdType <> 'APPL') then
            NextLaunch := '';
        if MultiFinder then
            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
    end;            { HelloTabby procedure }
end.                { Unit }